home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
CMPLTPAS
/
SCRIBBLE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-09-02
|
4KB
|
120 lines
{--------------------------------------------------------------}
{ SCRIBBLE }
{ }
{ Freehand graphics sketchpad program }
{ }
{ by Jeff Duntemann }
{ Turbo Pascal V5.0 }
{ Last update 9/2/88 }
{ }
{ }
{ From: COMPLETE TURBO PASCAL 5.0 by Jeff Duntemann }
{ Scott, Foresman & Co., Inc. 1988 ISBN 0-673-38355-5 }
{--------------------------------------------------------------}
PROGRAM Scribble;
USES DOS,Crt,Graph,Mouse,PullDown;
{$I DEMOMENU.DEF } { This is a LARGE include file containing a }
{ sample menu array of type MenuDesc }
VAR
GraphDriver : Integer;
GraphMode : Integer;
ErrorCode : Integer;
I : Integer;
R : Real;
M1,M2,M3,M4 : Word;
ReturnCode : Word;
XText,YText : String;
Mule : String;
PointerX,
PointerY : Word;
Left,Center,
Right : Boolean;
Amulet : Boolean; { True if amulet was clicked on within Menu }
Quit : Boolean;
DuplicateCode : Byte;
ExitSave : Pointer;
VAR
SavedColor : Word;
Palette : PaletteType;
Color : Word;
{$F+} PROCEDURE ReturnToTextMode; {$F-}
BEGIN
PointerOff; { Turn off the mouse pointer }
CloseGraph; { Go back to text mode }
ExitProc := ExitSave
END;
BEGIN
ExitSave := ExitProc; { This ensures that we will ALWAYS }
ExitProc := @ReturnToTextMode; { re-enter text mode on return to DOS! }
ClrScr;
{ Check the menu structure to be sure all codes are unique: }
IF InvalidMenu(DemoMenu,DuplicateCode) THEN
BEGIN
Writeln('>>Halted for invalid menu: Duplicate code ',
DuplicateCode);
Halt(1)
END;
GraphDriver := Detect; { Let the BGI determine what board we're using }
DetectGraph(GraphDriver,GraphMode);
InitGraph(GraphDriver,GraphMode,'');
IF GraphResult <> 0 THEN
BEGIN
Writeln('>>Halted on graphics error: ',GraphErrorMsg(GraphResult));
Halt(2)
END;
SetupMenu(DemoMenu);
PointerOn;
SetColor(Yellow); Quit := False;
REPEAT
PollMouse(PointerX,PointerY,Left,Center,Right);
IF Left THEN
BEGIN
IF PointerY < 12 THEN { We're in the menu bar; call Menu: }
BEGIN
Menu(DemoMenu,ReturnCode,Amulet);
{ Update graphics CP to reflect motion while in Menu: }
PollMouse(PointerX,PointerY,Left,Center,Right);
MoveTo(PointerX,PointerY);
{ This CASE..OF statement parses menu items and takes action }
IF ReturnCode <> 0 THEN
CASE ReturnCode OF
25 : Quit := True;
{ Here is where you parse out other codes returned from }
{ procedure Menu. Put a CASE selector for each valid }
{ code, and then implement some action for each CASE }
{ selector. }
END; { CASE }
END
ELSE
IF (GetX <> PointerX) OR (GetY <> PointerY) THEN
BEGIN { If we not in the menu bar, then we sketch: }
PointerOff;
LineTo(PointerX,PointerY);
PointerOn
END
END
ELSE MoveTo(PointerX,PointerY)
UNTIL KeyPressed OR Quit;
{ Note that CloseGraph is executed from the MAIN exit procedure! }
END.